home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-2 / iconc.sit / tree.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-09-19  |  17.5 KB  |  779 lines  |  [TEXT/MPS ]
  1. /*
  2.  * tree.c -- functions for constructing parse trees
  3.  */
  4.  
  5. #include "::h:gsupport.h"
  6. #include "trans.h"
  7. #include "tlex.h"
  8. #include "tree.h"
  9. #include "tsym.h"
  10. #include "token.h"
  11. #include "tcode.h"
  12. #include "tproto.h"
  13.  
  14. /*
  15.  * prototypes for static functions.
  16.  */
  17. hidden nodeptr chk_empty Params((nodeptr n));
  18. hidden novalue put_elms  Params((nodeptr t, nodeptr args, int slot));
  19. hidden nodeptr subsc_nd  Params((nodeptr op, nodeptr arg1, nodeptr arg2));
  20.  
  21. /*
  22.  *  tree[1-6] construct parse tree nodes with specified values.
  23.  *   loc_model is a node containing the same line and column information
  24.  *   as is needed in this node, while parameters a through d are values to
  25.  *   be assigned to n_field[0-3]. Note that this could be done with a
  26.  *   single routine; a separate routine for each node size is used for
  27.  *   speed and simplicity.
  28.  */
  29.  
  30. nodeptr tree1(type)
  31. int type;
  32.    {
  33.    register nodeptr t;
  34.  
  35.    t = NewNode(0);
  36.    t->n_type = type;
  37.    t->n_file = NULL;
  38.    t->n_line = 0;
  39.    t->n_col = 0;
  40.    t->freetmp = NULL;
  41.    return t;
  42.    }
  43.  
  44. nodeptr tree2(type, loc_model)
  45. int type;
  46. nodeptr loc_model;
  47.    {
  48.    register nodeptr t;
  49.  
  50.    t = NewNode(0);
  51.    t->n_type = type;
  52.    t->n_file = loc_model->n_file;
  53.    t->n_line = loc_model->n_line;
  54.    t->n_col = loc_model->n_col;
  55.    t->freetmp = NULL;
  56.    return t;
  57.    }
  58.  
  59. nodeptr tree3(type, loc_model, a)
  60. int type;
  61. nodeptr loc_model;
  62. nodeptr a;
  63.    {
  64.    register nodeptr t;
  65.  
  66.    t = NewNode(1);
  67.    t->n_type = type;
  68.    t->n_file = loc_model->n_file;
  69.    t->n_line = loc_model->n_line;
  70.    t->n_col = loc_model->n_col;
  71.    t->freetmp = NULL;
  72.    t->n_field[0].n_ptr = a;
  73.    return t;
  74.    }
  75.  
  76. nodeptr tree4(type, loc_model, a, b)
  77. int type;
  78. nodeptr loc_model;
  79. nodeptr a, b;
  80.    {
  81.    register nodeptr t;
  82.  
  83.    t = NewNode(2);
  84.    t->n_type = type;
  85.    t->n_file = loc_model->n_file;
  86.    t->n_line = loc_model->n_line;
  87.    t->n_col = loc_model->n_col;
  88.    t->freetmp = NULL;
  89.    t->n_field[0].n_ptr = a;
  90.    t->n_field[1].n_ptr = b;
  91.    return t;
  92.    }
  93.  
  94. nodeptr tree5(type, loc_model, a, b, c)
  95. int type;
  96. nodeptr loc_model;
  97. nodeptr a, b, c;
  98.    {
  99.    register nodeptr t;
  100.  
  101.    t = NewNode(3);
  102.    t->n_type = type;
  103.    t->n_file = loc_model->n_file;
  104.    t->n_line = loc_model->n_line;
  105.    t->n_col = loc_model->n_col;
  106.    t->freetmp = NULL;
  107.    t->n_field[0].n_ptr = a;
  108.    t->n_field[1].n_ptr = b;
  109.    t->n_field[2].n_ptr = c;
  110.    return t;
  111.    }
  112.  
  113. nodeptr tree6(type, loc_model, a, b, c, d)
  114. int type;
  115. nodeptr loc_model;
  116. nodeptr a, b, c, d;
  117.    {
  118.    register nodeptr t;
  119.  
  120.    t = NewNode(4);
  121.    t->n_type = type;
  122.    t->n_file = loc_model->n_file;
  123.    t->n_line = loc_model->n_line;
  124.    t->n_col = loc_model->n_col;
  125.    t->freetmp = NULL;
  126.    t->n_field[0].n_ptr = a;
  127.    t->n_field[1].n_ptr = b;
  128.    t->n_field[2].n_ptr = c;
  129.    t->n_field[3].n_ptr = d;
  130.    return t;
  131.    }
  132.  
  133. nodeptr int_leaf(type, loc_model, a)
  134. int type;
  135. nodeptr loc_model;
  136. int a;
  137.    {
  138.    register nodeptr t;
  139.  
  140.    t = NewNode(1);
  141.    t->n_type = type;
  142.    t->n_file = loc_model->n_file;
  143.    t->n_line = loc_model->n_line;
  144.    t->n_col = loc_model->n_col;
  145.    t->freetmp = NULL;
  146.    t->n_field[0].n_val = a;
  147.    return t;
  148.    }
  149.  
  150. nodeptr c_str_leaf(type, loc_model, a)
  151. int type;
  152. nodeptr loc_model;
  153. char *a;
  154.    {
  155.    register nodeptr t;
  156.  
  157.    t = NewNode(1);
  158.    t->n_type = type;
  159.    t->n_file = loc_model->n_file;
  160.    t->n_line = loc_model->n_line;
  161.    t->n_col = loc_model->n_col;
  162.    t->freetmp = NULL;
  163.    t->n_field[0].n_str = a;
  164.    return t;
  165.    }
  166.  
  167. /*
  168.  * i_str_leaf - create a leaf node containing a string and length.
  169.  */
  170. nodeptr i_str_leaf(type, loc_model, a, b)
  171. int type;
  172. nodeptr loc_model;
  173. char *a;
  174. int b;
  175.    {
  176.    register nodeptr t;
  177.  
  178.    t = NewNode(2);
  179.    t->n_type = type;
  180.    t->n_file = loc_model->n_file;
  181.    t->n_line = loc_model->n_line;
  182.    t->n_col = loc_model->n_col;
  183.    t->freetmp = NULL;
  184.    t->n_field[0].n_str = a;
  185.    t->n_field[1].n_val = b;
  186.    return t;
  187.    }
  188.  
  189. /*
  190.  * key_leaf - create a leaf node for a keyword.
  191.  */
  192. nodeptr key_leaf(loc_model, keyname)
  193. nodeptr loc_model;
  194. char *keyname;
  195.    {
  196.    register nodeptr t;
  197.    struct implement *ip;
  198.    struct il_code *il;
  199.    char *s;
  200.    int typcd;
  201.  
  202.    /*
  203.     * Find the data base entry for the keyword, if it exists.
  204.     */
  205.    ip = db_ilkup(keyname, khash);
  206.  
  207.    if (ip == NULL)
  208.       tfatal("invalid keyword", keyname);
  209.    else if (ip->in_line == NULL)
  210.       tfatal("keyword not installed", keyname);
  211.    else {
  212.       il = ip->in_line;
  213.       s = il->u[1].s;
  214.       if (il->il_type == IL_Const) {
  215.         /*
  216.          * This is a constant keyword, treat it as a literal.
  217.          */
  218.         t = NewNode(1);
  219.         t->n_file = loc_model->n_file;
  220.         t->n_line = loc_model->n_line;
  221.         t->n_col = loc_model->n_col;
  222.         t->freetmp = NULL;
  223.         typcd = il->u[0].n;
  224.         if (typcd == cset_typ) {
  225.            t->n_type =  N_Cset;
  226.            CSym0(t) = putlit(&s[1], F_CsetLit, strlen(s) - 2);
  227.            }
  228.         else if (typcd == int_typ) {
  229.            t->n_type = N_Int;
  230.            CSym0(t) = putlit(s, F_IntLit, 0);
  231.            }
  232.         else if (typcd == real_typ) {
  233.            t->n_type = N_Real;
  234.            CSym0(t) = putlit(s, F_RealLit, 0);
  235.            }
  236.         else if (typcd == str_typ) {
  237.            t->n_type = N_Str;
  238.            CSym0(t) = putlit(&s[1], F_StrLit, strlen(s) - 2);
  239.            }
  240.         return t;
  241.         }
  242.      }
  243.  
  244.    t = NewNode(2);
  245.    t->n_type = N_InvOp;
  246.    t->n_file = loc_model->n_file;
  247.    t->n_line = loc_model->n_line;
  248.    t->n_col = loc_model->n_col;
  249.    t->freetmp = NULL;
  250.    t->n_field[0].n_val = 0;      /* number of arguments */
  251.    t->n_field[1].ip = ip;
  252.    return t;
  253.    }
  254.  
  255. /*
  256.  * list_nd - create a list creation node.
  257.  */
  258. nodeptr list_nd(loc_model, args)
  259. nodeptr loc_model;
  260. nodeptr args;
  261.    {
  262.    register nodeptr t;
  263.    struct implement *impl;
  264.    int nargs;
  265.  
  266.    /*
  267.     * Determine the number of arguments.
  268.     */
  269.    if (args->n_type == N_Empty)
  270.       nargs = 0;
  271.    else {
  272.       nargs = 1;
  273.       for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
  274.          ++nargs;
  275.       if (nargs > max_prm)
  276.          max_prm = nargs;
  277.       }
  278.  
  279.    impl = spec_op[ListOp];
  280.    if (impl == NULL)
  281.       nfatal(loc_model, "list creation not implemented", NULL);
  282.    else if (impl->in_line == NULL)
  283.       nfatal(loc_model, "list creation not installed", NULL);
  284.  
  285.    t = NewNode(nargs + 2);
  286.    t->n_type = N_InvOp;
  287.    t->n_file = loc_model->n_file;
  288.    t->n_line = loc_model->n_line;
  289.    t->n_col = loc_model->n_col;
  290.    t->freetmp = NULL;
  291.    t->n_field[0].n_val = nargs;
  292.    t->n_field[1].ip = impl;
  293.    if (nargs > 0)
  294.       put_elms(t, args, nargs + 1);
  295.    return t;
  296.    }
  297.  
  298. /*
  299.  * invk_nd - create a node for invocation.
  300.  */
  301. nodeptr invk_nd(loc_model, proc, args)
  302. nodeptr loc_model;
  303. nodeptr proc;
  304. nodeptr args;
  305.    {
  306.    register nodeptr t;
  307.    int nargs;
  308.  
  309.    /*
  310.     * Determine the number of arguments.
  311.     */
  312.    if (args->n_type == N_Empty)
  313.       nargs = 0;
  314.    else {
  315.       nargs = 1;
  316.       for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
  317.          ++nargs;
  318.       if (nargs > max_prm)
  319.          max_prm = nargs;
  320.       }
  321.  
  322.    t = NewNode(nargs + 2);
  323.    t->n_type = N_Invok;
  324.    t->n_file = loc_model->n_file;
  325.    t->n_line = loc_model->n_line;
  326.    t->n_col = loc_model->n_col;
  327.    t->freetmp = NULL;
  328.    t->n_field[0].n_val = nargs;
  329.    t->n_field[1].n_ptr = proc;
  330.    if (nargs > 0)
  331.       put_elms(t, args, nargs + 1);
  332.    return t;
  333.    }
  334.  
  335. /*
  336.  * put_elms - convert a linked list of arguments into an array of arguments
  337.  *  in a node.
  338.  */
  339. static novalue put_elms(t, args, slot)
  340. nodeptr t;
  341. nodeptr args;
  342. int slot;
  343.    {
  344.    if (args->n_type == N_Elist) {
  345.       /*
  346.        * The linked list is in reverse argument order.
  347.        */
  348.       t->n_field[slot].n_ptr = chk_empty(args->n_field[1].n_ptr);
  349.       put_elms(t, args->n_field[0].n_ptr, slot - 1);
  350.       free(args);
  351.       }
  352.    else
  353.       t->n_field[slot].n_ptr = chk_empty(args);
  354.    }
  355.  
  356. /*
  357.  * chk_empty - if an argument is empty, replace it with &null.
  358.  */
  359. static nodeptr chk_empty(n)
  360. nodeptr n;
  361.    {
  362.    if (n->n_type == N_Empty)
  363.       n = key_leaf(n, spec_str("null"));
  364.    return n;
  365.    }
  366.  
  367. /*
  368.  * case_nd - create a node for a case statement.
  369.  */
  370. nodeptr case_nd(loc_model, expr, cases)
  371. nodeptr loc_model;
  372. nodeptr expr;
  373. nodeptr cases;
  374.    {
  375.    register nodeptr t;
  376.    nodeptr reverse;
  377.    nodeptr nxt_cases;
  378.    nodeptr ccls;
  379.  
  380.    t = NewNode(3);
  381.    t->n_type = N_Case;
  382.    t->n_file = loc_model->n_file;
  383.    t->n_line = loc_model->n_line;
  384.    t->n_col = loc_model->n_col;
  385.    t->freetmp = NULL;
  386.    t->n_field[0].n_ptr = expr;
  387.    t->n_field[2].n_ptr = NULL;
  388.  
  389.    /*
  390.     * The list of cases is in reverse order. Walk the list reversing it,
  391.     *  and extract the default clause if one exists.
  392.     */
  393.    reverse = NULL;
  394.    while (cases->n_type != N_Ccls) {
  395.       nxt_cases = cases->n_field[0].n_ptr;
  396.       ccls = cases->n_field[1].n_ptr;
  397.       if (ccls->n_field[0].n_ptr->n_type == N_Res) {
  398.          /*
  399.           * default clause.
  400.           */
  401.          if (t->n_field[2].n_ptr == NULL)
  402.             t->n_field[2].n_ptr = ccls->n_field[1].n_ptr;
  403.          else
  404.             nfatal(ccls, "duplicate default clause", NULL);
  405.          }
  406.        else {
  407.           if (reverse == NULL) {
  408.              reverse = cases;
  409.              reverse->n_field[0].n_ptr = ccls;
  410.              }
  411.           else {
  412.              reverse->n_field[1].n_ptr = ccls;
  413.              cases->n_field[0].n_ptr = reverse;
  414.              reverse = cases;
  415.              }
  416.          }
  417.       cases = nxt_cases;
  418.       }
  419.  
  420.    /*
  421.     * Last element in list.
  422.     */
  423.    if (cases->n_field[0].n_ptr->n_type == N_Res) {
  424.       /*
  425.        * default clause.
  426.        */
  427.       if (t->n_field[2].n_ptr == NULL)
  428.          t->n_field[2].n_ptr = cases->n_field[1].n_ptr;
  429.       else
  430.          nfatal(ccls, "duplicate default clause", NULL);
  431.       if (reverse != NULL)
  432.          reverse = reverse->n_field[0].n_ptr;
  433.       }
  434.    else {
  435.       if (reverse == NULL)
  436.          reverse = cases;
  437.       else
  438.          reverse->n_field[1].n_ptr = cases;
  439.       }
  440.    t->n_field[1].n_ptr = reverse;
  441.    return t;
  442.    }
  443.  
  444. /*
  445.  * multiunary - construct nodes to implement a sequence of unary operators
  446.  *  that have been lexically analyzed as one operator.
  447.  */
  448. nodeptr multiunary(op, loc_model, oprnd)
  449. nodeptr loc_model;
  450. char *op;
  451. nodeptr oprnd;
  452.    {
  453.    int n;
  454.    nodeptr nd;
  455.  
  456.    if (*op == '\0')
  457.      return oprnd;
  458.    for (n = 0; optab[n].tok.t_word != NULL; ++n)
  459.       if ((optab[n].expected & Unary) & (*(optab[n].tok.t_word) == *op)) {
  460.          nd = OpNode(n);
  461.          nd->n_file = loc_model->n_file;
  462.          nd->n_line = loc_model->n_line;
  463.          nd->n_col = loc_model->n_col;
  464.          return unary_nd(nd,multiunary(++op,loc_model,oprnd));
  465.          }
  466.    fprintf(stderr, "compiler error: inconsistent parsing of unary operators");
  467.    exit(ErrorExit);
  468.    }
  469.  
  470. /*
  471.  * binary_nd - construct a node for a binary operator.
  472.  */
  473. nodeptr binary_nd(op, arg1, arg2)
  474. nodeptr op;
  475. nodeptr arg1;
  476. nodeptr arg2;
  477.    {
  478.    register nodeptr t;
  479.    struct implement *impl;
  480.  
  481.    /*
  482.     * Find the data base entry for the operator.
  483.     */
  484.    impl = optab[Val0(op)].binary;
  485.    if (impl == NULL)
  486.       nfatal(op, "binary operator not implemented", optab[Val0(op)].tok.t_word);
  487.    else if (impl->in_line == NULL)
  488.       nfatal(op, "binary operator not installed", optab[Val0(op)].tok.t_word);
  489.  
  490.    t = NewNode(4);
  491.    t->n_type = N_InvOp;
  492.    t->n_file = op->n_file;
  493.    t->n_line = op->n_line;
  494.    t->n_col = op->n_col;
  495.    t->freetmp = NULL;
  496.    t->n_field[0].n_val = 2;      /* number of arguments */
  497.    t->n_field[1].ip = impl;
  498.    t->n_field[2].n_ptr = arg1;
  499.    t->n_field[3].n_ptr = arg2;
  500.    return t;
  501.    }
  502.  
  503. /*
  504.  * unary_nd - construct a node for a unary operator.
  505.  */
  506. nodeptr unary_nd(op, arg)
  507. nodeptr op;
  508. nodeptr arg;
  509.    {
  510.    register nodeptr t;
  511.    struct implement *impl;
  512.  
  513.    /*
  514.     * Find the data base entry for the operator.
  515.     */
  516.    impl = optab[Val0(op)].unary;
  517.    if (impl == NULL)
  518.       nfatal(op, "unary operator not implemented", optab[Val0(op)].tok.t_word);
  519.    else if (impl->in_line == NULL)
  520.       nfatal(op, "unary operator not installed", optab[Val0(op)].tok.t_word);
  521.  
  522.    t = NewNode(3);
  523.    t->n_type = N_InvOp;
  524.    t->n_file = op->n_file;
  525.    t->n_line = op->n_line;
  526.    t->n_col = op->n_col;
  527.    t->freetmp = NULL;
  528.    t->n_field[0].n_val = 1;      /* number of arguments */
  529.    t->n_field[1].ip = impl;
  530.    t->n_field[2].n_ptr = arg;
  531.    return t;
  532.    }
  533.  
  534. /*
  535.  * buildarray - convert "multi-dimensional" subscripting into a sequence
  536.  *  of subsripting operations.
  537.  */
  538. nodeptr buildarray(a,lb,e)
  539. nodeptr a, lb, e;
  540.    {
  541.    register nodeptr t, t2;
  542.    if (e->n_type == N_Elist) {
  543.       t2 = int_leaf(lb->n_type, lb, lb->n_field[0].n_val);
  544.       t = subsc_nd(t2, buildarray(a,lb,e->n_field[0].n_ptr),
  545.          e->n_field[1].n_ptr);
  546.       free(e);
  547.       }
  548.    else
  549.       t = subsc_nd(lb, a, e);
  550.    return t;
  551.    }
  552.  
  553. /*
  554.  * subsc_nd - construct a node for subscripting.
  555.  */
  556. static nodeptr subsc_nd(op, arg1, arg2)
  557. nodeptr op;
  558. nodeptr arg1;
  559. nodeptr arg2;
  560.    {
  561.    register nodeptr t;
  562.    struct implement *impl;
  563.  
  564.    /*
  565.     * Find the data base entry for subscripting.
  566.     */
  567.    impl = spec_op[SubscOp];
  568.    if (impl == NULL)
  569.       nfatal(op, "subscripting not implemented", NULL);
  570.    else if (impl->in_line == NULL)
  571.       nfatal(op, "subscripting not installed", NULL);
  572.  
  573.    t = NewNode(4);
  574.    t->n_type = N_InvOp;
  575.    t->n_file = op->n_file;
  576.    t->n_line = op->n_line;
  577.    t->n_col = op->n_col;
  578.    t->freetmp = NULL;
  579.    t->n_field[0].n_val = 2;      /* number of arguments */
  580.    t->n_field[1].ip = impl;
  581.    t->n_field[2].n_ptr = arg1;
  582.    t->n_field[3].n_ptr = arg2;
  583.    return t;
  584.    }
  585.  
  586. /*
  587.  * to_nd - construct a node for binary to.
  588.  */
  589. nodeptr to_nd(op, arg1, arg2)
  590. nodeptr op;
  591. nodeptr arg1;
  592. nodeptr arg2;
  593.    {
  594.    register nodeptr t;
  595.    struct implement *impl;
  596.  
  597.    /*
  598.     * Find the data base entry for to.
  599.     */
  600.    impl = spec_op[ToOp];
  601.    if (impl == NULL)
  602.       nfatal(op, "'i to j' not implemented", NULL);
  603.    else if (impl->in_line == NULL)
  604.       nfatal(op, "'i to j' not installed", NULL);
  605.  
  606.    t = NewNode(4);
  607.    t->n_type = N_InvOp;
  608.    t->n_file = op->n_file;
  609.    t->n_line = op->n_line;
  610.    t->n_col = op->n_col;
  611.    t->freetmp = NULL;
  612.    t->n_field[0].n_val = 2;      /* number of arguments */
  613.    t->n_field[1].ip = impl;
  614.    t->n_field[2].n_ptr = arg1;
  615.    t->n_field[3].n_ptr = arg2;
  616.    return t;
  617.    }
  618.  
  619. /*
  620.  * toby_nd - construct a node for binary to-by.
  621.  */
  622. nodeptr toby_nd(op, arg1, arg2, arg3)
  623. nodeptr op;
  624. nodeptr arg1;
  625. nodeptr arg2;
  626. nodeptr arg3;
  627.    {
  628.    register nodeptr t;
  629.    struct implement *impl;
  630.  
  631.    /*
  632.     * Find the data base entry for to-by.
  633.     */
  634.    impl = spec_op[ToByOp];
  635.    if (impl == NULL)
  636.       nfatal(op, "'i to j by k' not implemented", NULL);
  637.    else if (impl->in_line == NULL)
  638.       nfatal(op, "'i to j by k' not installed", NULL);
  639.  
  640.    t = NewNode(5);
  641.    t->n_type = N_InvOp;
  642.    t->n_file = op->n_file;
  643.    t->n_line = op->n_line;
  644.    t->n_col = op->n_col;
  645.    t->freetmp = NULL;
  646.    t->n_field[0].n_val = 3;      /* number of arguments */
  647.    t->n_field[1].ip = impl;
  648.    t->n_field[2].n_ptr = arg1;
  649.    t->n_field[3].n_ptr = arg2;
  650.    t->n_field[4].n_ptr = arg3;
  651.    return t;
  652.    }
  653.  
  654. /*
  655.  * aug_nd - create a node for an augmented assignment.
  656.  */
  657. nodeptr aug_nd(op, arg1, arg2)
  658. nodeptr op;
  659. nodeptr arg1;
  660. nodeptr arg2;
  661.    {
  662.    register nodeptr t;
  663.    struct implement *impl;
  664.  
  665.    t = NewNode(5);
  666.    t->n_type = N_Augop;
  667.    t->n_file = op->n_file;
  668.    t->n_line = op->n_line;
  669.    t->n_col = op->n_col;
  670.    t->freetmp = NULL;
  671.  
  672.    /*
  673.     * Find the data base entry for assignment.
  674.     */
  675.    impl = optab[asgn_loc].binary;
  676.    if (impl == NULL)
  677.       nfatal(op, "assignment not implemented", NULL);
  678.    t->n_field[0].ip = impl;
  679.  
  680.    /*
  681.     * The operator table entry for the augmented assignment is
  682.     *  immediately after the entry for the operation.
  683.     */
  684.    impl = optab[Val0(op) - 1].binary;
  685.    if (impl == NULL)
  686.       nfatal(op, "binary operator not implemented",
  687.          optab[Val0(op) - 1].tok.t_word);
  688.    t->n_field[1].ip = impl;
  689.  
  690.    t->n_field[2].n_ptr = arg1;
  691.    t->n_field[3].n_ptr = arg2;
  692.    /* t->n_field[4].typ - type of intermediate result */
  693.    return t;
  694.    }
  695.  
  696. /*
  697.  * sect_nd - create a node for sectioning.
  698.  */
  699. nodeptr sect_nd(op, arg1, arg2, arg3)
  700. nodeptr op;
  701. nodeptr arg1;
  702. nodeptr arg2;
  703. nodeptr arg3;
  704.    {
  705.    register nodeptr t;
  706.    int tok;
  707.    struct implement *impl;
  708.    struct implement *impl1;
  709.  
  710.    t = NewNode(5);
  711.    t->n_file = op->n_file;
  712.    t->n_line = op->n_line;
  713.    t->n_col = op->n_col;
  714.    t->freetmp = NULL;
  715.  
  716.    /*
  717.     * Find the data base entry for sectioning.
  718.     */
  719.    impl = spec_op[SectOp];
  720.    if (impl == NULL)
  721.       nfatal(op, "sectioning not implemented", NULL);
  722.  
  723.    tok = optab[Val0(op)].tok.t_type;
  724.    if (tok == COLON) {
  725.       /*
  726.        * Simple sectioning, treat as a ternary operator.
  727.        */
  728.       t->n_type = N_InvOp;
  729.       t->n_field[0].n_val = 3;      /* number of arguments */
  730.       t->n_field[1].ip = impl;
  731.       }
  732.    else {
  733.       /*
  734.        * Find the data base entry for addition or subtraction.
  735.        */
  736.       if (tok == PCOLON) {
  737.          impl1 = optab[plus_loc].binary;
  738.          if (impl1 == NULL)
  739.             nfatal(op, "addition not implemented", NULL);
  740.          }
  741.       else { /* MCOLON */
  742.          impl1 = optab[minus_loc].binary;
  743.          if (impl1 == NULL)
  744.             nfatal(op, "subtraction not implemented", NULL);
  745.          }
  746.       t->n_type = N_Sect;
  747.       t->n_field[0].ip = impl;
  748.       t->n_field[1].ip = impl1;
  749.       }
  750.    t->n_field[2].n_ptr = arg1;
  751.    t->n_field[3].n_ptr = arg2;
  752.    t->n_field[4].n_ptr = arg3;
  753.    return t;
  754.    }
  755.  
  756. /*
  757.  * invk_main - produce an procedure invocation node with one argument for
  758.  *  use in the initial invocation to main() during type inference.
  759.  */
  760. nodeptr invk_main(main_proc)
  761. struct pentry *main_proc;
  762.    {
  763.    register nodeptr t;
  764.  
  765.    t = NewNode(3);
  766.    t->n_type = N_InvProc;
  767.    t->n_file = NULL; 
  768.    t->n_line = 0;
  769.    t->n_col = 0;
  770.    t->freetmp = NULL;
  771.    t->n_field[0].n_val = 1;               /* 1 argument */
  772.    t->n_field[1].proc = main_proc;
  773.    t->n_field[2].n_ptr = tree1(N_Empty);
  774.  
  775.    if (max_prm < 1)
  776.       max_prm = 1;
  777.    return t;
  778.    }
  779.